home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BMUG Revelations
/
BMUG Revelations.toast
/
Programming
/
Programming Languages
/
UCB Logo 3.0
/
CSLS
/
compile
< prev
next >
Wrap
Text File
|
1992-09-04
|
4KB
|
134 lines
TO COMPILE :PROCS
IF WORDP :PROCS [COMPILE1 :PROCS STOP]
IF EMPTYP :PROCS [STOP]
COMPILE1 FIRST :PROCS
COMPILE BF :PROCS
END
TO COMPILE.FILTER :TEMPLATE :LIST
LOCAL [GENPROC GENINPUT]
MAKE "GENPROC GENSYM
MAKE "GENINPUT GENSYM
DEFINE :GENPROC (LIST ~
(LIST :GENINPUT) ~
(SE [IF EMPTYP] DOTS :GENINPUT (LIST (LIST "OUTPUT DOTS :GENINPUT))) ~
(SE [IF (] COMPILE.TEMPLATE :GENINPUT :TEMPLATE [)] ~
(LIST (SE [OUTPUT COMBINE ( FIRST] DOTS :GENINPUT [)] ~
[(] :GENPROC "BF DOTS :GENINPUT [)] ))) ~
(SE "OUTPUT :GENPROC "BF DOTS :GENINPUT))
OUTPUT FPUT :GENPROC :LIST
END
TO COMPILE.FOREACH :TEMPLATE :LIST
LOCAL [GENPROC GENINPUT]
MAKE "GENPROC GENSYM
MAKE "GENINPUT GENSYM
DEFINE :GENPROC (LIST ~
(LIST :GENINPUT) ~
(SE [IF EMPTYP] DOTS :GENINPUT [[STOP]]) ~
(COMPILE.TEMPLATE :GENINPUT :TEMPLATE) ~
(SE :GENPROC "BF DOTS :GENINPUT))
OUTPUT FPUT :GENPROC :LIST
END
TO COMPILE.LINE :LINE
IF EMPTYP :LINE [OUTPUT []]
IF LISTP FIRST :LINE ~
[OUTPUT FPUT (COMPILE.LINE FIRST :LINE) (COMPILE.LINE BF :LINE)]
IF MEMBERP FIRST :LINE [FOREACH MAP REDUCE FILTER] ~
[OUTPUT SE (COMPILE.SPECIAL TOCLOSE :LINE) ~
(COMPILE.LINE FROMCLOSE :LINE)]
OUTPUT FPUT (FIRST :LINE) (COMPILE.LINE BF :LINE)
END
TO COMPILE.MAP :TEMPLATE :LIST
LOCAL [GENPROC GENINPUT]
MAKE "GENPROC GENSYM
MAKE "GENINPUT GENSYM
DEFINE :GENPROC (LIST ~
(LIST :GENINPUT) ~
(SE [IF EMPTYP] DOTS :GENINPUT (LIST (LIST "OUTPUT DOTS :GENINPUT))) ~
(SE [OUTPUT COMBINE (] COMPILE.TEMPLATE :GENINPUT :TEMPLATE [)] ~
[(] :GENPROC "BF DOTS :GENINPUT [)] ))
OUTPUT FPUT :GENPROC :LIST
END
TO COMPILE.REDUCE :FUNCTION :LIST
LOCAL [GENPROC GENINPUT]
MAKE "GENPROC GENSYM
MAKE "GENINPUT GENSYM
DEFINE :GENPROC (LIST ~
(LIST :GENINPUT) ~
(SE [IF EMPTYP BF] DOTS :GENINPUT ~
(LIST (SE [OUTPUT FIRST] DOTS :GENINPUT))) ~
(SE "OUTPUT :FUNCTION [( FIRST] DOTS :GENINPUT [)] ~
[(] :GENPROC "BF DOTS :GENINPUT [)] ))
OUTPUT FPUT :GENPROC :LIST
END
TO COMPILE.SPECIAL :EXPR
IF EQUALP FIRST :EXPR "FOREACH ~
[OUTPUT COMPILE.FOREACH (LAST :EXPR) (COMPILE.LINE BL BF :EXPR)]
OUTPUT RUN FPUT (WORD "COMPILE. FIRST :EXPR) ~
(LIST FIRST BF :EXPR COMPILE.LINE BF BF :EXPR)
END
TO COMPILE.TEMPLATE :INPUT :TEMPLATE
IF EMPTYP :TEMPLATE [OUTPUT []]
IF LISTP FIRST :TEMPLATE ~
[OUTPUT FPUT (COMPILE.TEMPLATE :INPUT FIRST :TEMPLATE) ~
(COMPILE.TEMPLATE :INPUT BF :TEMPLATE)]
IF EQUALP FIRST :TEMPLATE "? ~
[OUTPUT (SE [( FIRST] DOTS :INPUT [)] ~
(COMPILE.TEMPLATE :INPUT BF :TEMPLATE))]
OUTPUT FPUT (FIRST :TEMPLATE) (COMPILE.TEMPLATE :INPUT BF :TEMPLATE)
END
TO COMPILE.TEXT :LINES
IF EMPTYP :LINES [OUTPUT []]
OUTPUT FPUT (COMPILE.LINE FIRST :LINES) (COMPILE.TEXT BF :LINES)
END
TO COMPILE1 :PROC
LOCAL "TEXT
IF PROCEDUREP WORD :PROC ".PRECOMPILE [STOP]
MAKE "TEXT TEXT :PROC
DEFINE (WORD :PROC ".PRECOMPILE) :TEXT
DEFINE :PROC FPUT FIRST :TEXT COMPILE.TEXT BF :TEXT
END
TO DOTS :NAME
OUTPUT WORD ": :NAME
END
TO FROMCLOSE :LIST
OUTPUT FROMCLOSE1 :LIST 0
END
TO FROMCLOSE1 :LIST :LEVEL
IF EMPTYP :LIST [OUTPUT []]
IF EQUALP FIRST :LIST "\) ~
[IFELSE EQUALP :LEVEL 0 ~
[OUTPUT :LIST] [OUTPUT FROMCLOSE1 BF :LIST :LEVEL-1]]
IF EQUALP FIRST :LIST "\( [OUTPUT FROMCLOSE1 BF :LIST :LEVEL+1]
OUTPUT FROMCLOSE1 BF :LIST :LEVEL
END
TO TOCLOSE :LIST
OUTPUT TOCLOSE1 :LIST 0
END
TO TOCLOSE1 :LIST :LEVEL
IF EMPTYP :LIST [OUTPUT []]
IF EQUALP FIRST :LIST "\) ~
[IFELSE EQUALP :LEVEL 0 ~
[OUTPUT []] [OUTPUT TOCLOSE2 :LIST :LEVEL-1]]
IF EQUALP FIRST :LIST "\( [OUTPUT TOCLOSE2 :LIST :LEVEL+1]
OUTPUT TOCLOSE2 :LIST :LEVEL
END
TO TOCLOSE2 :LIST :LEVEL
OUTPUT FPUT FIRST :LIST TOCLOSE1 BF :LIST :LEVEL
END